#!/usr/bin/perl
use strict;
use warnings;
use utf8;

package Remedie::Server;
use base qw( HTTP::Server::Simple::CGI );
use DirHandle;
use HTTP::Date;
use MIME::Base64;
use MIME::Types;
use Template;
use URI;

use File::Find::Rule;

sub set_conf {
    my $self = shift;
    $self->{conf} = shift;
}

sub handle_request {
    my($self, $cgi) = @_;

    # inititliaze the request
    $self->{stash} = {};
    delete $self->{template};

    $cgi->charset("utf-8");

    print STDERR
        $ENV{REMOTE_ADDR}, " ",
        '[', scalar(localtime), '] ',
        '"', $ENV{REQUEST_METHOD}, " ",
        $cgi->path_info,
        ($cgi->query_string ? '?' . $cgi->query_string : ''), '" ',
        "$ENV{HTTP_USER_AGENT}\n";
    eval {
        if ($cgi->path_info eq '/') {
            print "HTTP/1.0 302 Moved\r\n";
            print $cgi->redirect($cgi->url . "/browse");
            return;
        } elsif ($cgi->path_info =~ m!^/icon!) {
            $self->handle_feed_icon($cgi);
        } elsif ($cgi->path_info =~ m!^/rss/?(.*)$!) {
            $self->handle_feed($cgi, $1);
        } elsif ($cgi->path_info =~ m!^/files/(.*)$!) {
            $self->handle_file($cgi, $1);
        } elsif ($cgi->path_info =~ m!^/browse/?(.*)$!) {
            $self->handle_list($cgi, $1);
        } elsif ($cgi->path_info =~ m!^/subscribe/miro$!) {
            $self->handle_miro($cgi);
        } elsif ($cgi->path_info =~ m!^/subscribe/opml$!) {
            $self->handle_opml($cgi);
        } else {
            die "404 Not found";
        }
    };

    if (my $err = $@) {
        if ($err =~ /not found/i) {
            print "HTTP/1.0 404 Not Found\r\n";
        } else {
            print "HTTP/1.0 500 Error\r\n";
        }
        my %esc = ('<' => '&lt;', '>' => '&gt;', '&' => '&amp;', '"' => '&quot;');
        $err =~ s/([<>&"])/$esc{$1}/g;
        print $cgi->header('text/html');
        print "<p>$err</p>";
        return;
    }

    return if $self->{stash}->{request_is_done};
    print "HTTP/1.0 200 OK\r\n";

    if ($self->{template}) {
        $self->{tt} ||= Template->new;
        binmode STDOUT, ":utf8";

        my $mime = $self->{stash}->{mime_type} || 'text/html';
        if (my $fn = $self->{stash}->{filename}) {
            print $cgi->header(-type => $mime, -content_disposition => qq(inline; filename="$fn"));
        } else {
            print $cgi->header(-type => $mime);
        }
        $self->decorate_template if $mime =~ /html/;
        $self->{tt}->process(\$self->{template}, { %{$self->{stash}}, server => $self, cgi => $cgi })
            or die $self->{tt}->error;
    } elsif (my $body = $self->{stash}->{http_body}) {
        print $cgi->header($self->{stash}->{mime_type}), $body;
    }
}

sub load_feed_icon {
    my $self = shift;
    $self->{feed_icon} = decode_base64(join '', <DATA>);
}

sub handle_feed_icon {
    my($self, $cgi) = @_;
    $self->{stash}->{mime_type} = 'image/gif';
    $self->{stash}->{http_body} = $self->{feed_icon};
}

sub decorate_template {
    my($self, $cgi) = @_;
    $self->{template} = <<TEMPLATE . $self->{template} . "\n</body></html>";
<html>
<head><title>Remedie: [% title %]</title>
<style>
h1, h2, h3 { font-size: 1.2em }
body,input { font-family: trebuchet MS; font-size: 12px }
input { background: #fff }
ul { list-style-type: none; margin-left: 0 }
a  { color: #000 }
</style>
</head>
<body>
<h1>Remedie: [% title %]</h1>
TEMPLATE
}

sub current_url {
    my($self, $cgi) = @_;
    my $uri = URI->new($cgi->url);
    $uri->path($cgi->path_info);
    return $uri;
}

sub sticky_url_for {
    my($self, $cgi, $format) = @_;

    my $uri  = URI->new($cgi->url);
    my $path = $cgi->path_info;
    if ($format eq 'html') {
        $path =~ s!/rss!/browse!;
    } else {
        $path =~ s!/browse!/rss!;
    }

    $uri->path($path);
    $uri->query($cgi->query_string) if $cgi->query_string;
    return $uri;
}

sub handle_feed {
    my($self, $cgi, $path) = @_;


    my $pathname;
    if ($path) {
        $pathname = Encode::decode_utf8( URI::Escape::uri_unescape($path) );
        $path     = Encode::encode($self->{conf}->{fs_encoding}, $pathname);
    }

    $self->{stash}->{title} = "/" . ($path || "");

    my @files = sort { $b->stat->mtime <=> $a->stat->mtime } 
        grep $_->stat, $self->locate_files($cgi, $path);
    $self->{stash}->{files} = \@files;

    $self->{stash}->{mime_type} = 'text/xml';
    $self->{template} = <<TEMPLATE;
<?xml version="1.0" encoding="UTF-8" ?>
<rss version="2.0" xmlns:media="http://search.yahoo.com/mrss/">
<channel>
<title>[% title | html %]</title>
<link>[% server.sticky_url_for(cgi, 'html') | html %]</link>
[% IF files.size; SET h = files.0 %]
[% IF h.has_thumb %]<image><url>[% h.thumb_url(cgi) | html %]</url></image>[% END %]
[% END %]
[% FOREACH m = files %]
<item>
<title>[% m.name | html %]</title>
<link>[% m.url(cgi.url) | html %]</link>
<pubDate>[% m.creation_date_rfc822 | html %]</pubDate>
<guid>[% m.url(cgi.url) | html %]</guid>
<media:content url="[% m.url(cgi.url) | html %]" fileSize="[% m.size | html %]" medium="video" type="[% m.mime_type | html %]">
<media:title type="plain">[% m.name | html %]</media:title>
<media:keywords>[% m.tags.join(', ') | html %]</media:keywords>
[% IF m.has_thumb %]<media:thumbnail url="[% m.thumb_url(cgi) | html %]" />[% END %]
</media:content>
<enclosure url="[% m.url(cgi.url) | html %]" type="[% m.mime_type | html %]" length="[% m.size | html %]" />
</item>
[% END %]
</channel>
</rss>
TEMPLATE
}

sub handle_list {
    my($self, $cgi, $path) = @_;

    my $pathname;
    if ($path) {
        $pathname = Encode::decode_utf8( URI::Escape::uri_unescape($path) );
        $path     = Encode::encode($self->{conf}->{fs_encoding}, $pathname);
    }

    $self->{stash}->{is_root} = 1 if !$path;
    $self->{stash}->{title} = "/" . ($pathname || "");

    my @folders = sort { lc $a->{name} cmp lc $b->{name} } $self->locate_folders($cgi, $path);
    $self->{stash}->{folders} = \@folders;

    my @files = sort { lc $a->{name} cmp lc $b->{name} } 
        grep { $_->stat } $self->locate_files($cgi, $path);
    $self->{stash}->{files} = \@files;

    $self->{template} = <<TEMPLATE;
[% SET current_url = server.current_url(cgi) -%]
<form method="get" id="search-form" action="[% current_url | html %]">
Match: <input type="text" name="q" size="20" value="[% cgi.param('q') | html %]" />
<input type="checkbox" name="no_regexp" [% IF cgi.param('no_regexp') %]checked="checked"[% END %] />no regexp
<input type="submit" value=" Filter " />
[% SET rss_url = server.sticky_url_for(cgi, 'rss') %]
<a href="[% rss_url | html %]"><img src="/icon" style="border:0" /></a>
[% IF server.conf.player == 'Miro' %]<a href="/subscribe/miro?url1=[% rss_url | uri %]">(Miro)</a>
[% END %]
</form>

<h2>Folders</h2>
<ul class="folders">
[% UNLESS is_root %]
<li class="folder"><a href="[% current_url %]/../">Parent Directory</a></li>
[% END %]
[% FOREACH folder = folders %]
<li class="folder"><a href="[% current_url %]/[% folder.name_utf8 | uri %]">[% folder.name | html %]</a></li>
[% END %]
</ul>

<h2>Files</h2>
<ul class="files">
[% FOREACH file = files %]
<li class="file"><a href="[% file.url(cgi.url) | html %]">[% file.name | html %]</a> [% file.creation_date | html %] [% FOREACH tag IN file.tags %][[% tag | html %]][% END %]</li>
[% END %]
</ul>
TEMPLATE
}

sub handle_miro {
    my($self, $cgi) = @_;

    my $base = URI->new($cgi->url);
    $base->path('/');

    $self->{stash}->{base}   = $base;
    $self->{stash}->{is_mac} = $ENV{HTTP_USER_AGENT} =~ /Mac OS X/;

    $self->{template} = <<'TEMPLATE';
Subscribing to [% cgi.param('url1') | html %] on Miro.
<iframe src="[% IF is_mac %]democracy:[% END %][% base %]subscribe/opml?url1=[% cgi.param('url1') | uri %]" style="position:absolute;x:-500px;width:1px;height:1px;"></iframe>
TEMPLATE
}

sub handle_opml {
    my($self, $cgi) = @_;

    $self->{stash}->{mime_type} = 'application/x-democracy';
    $self->{stash}->{filename}  = 'subscribe.democracy';
    $self->{stash}->{date} = DateTime::Format::Mail->new->format_datetime(DateTime->now);

    $self->{template} = <<'TEMPLATE';
<?xml version="1.0" encoding="UTF-8"?>
<opml version="2.0">
	<head>
		<title>Democracy Subscriptions</title>
		<dateCreated>[% date %]</dateCreated>
		<dateModified>[% date %]</dateModified>
	</head>
	<body>
<outline text="[% cgi.param('url1') | html %]" type="rss" version="RSS2" xmlUrl="[% cgi.param('url1') | html %]"/>
</body>
</opml>
TEMPLATE
}

sub locate_folders {
    my($self, $cgi, $path) = @_;

    my $dir = $self->path2dir($path);
    my $dh  = DirHandle->new($dir);
    my @folders;
    while (my $ent = $dh->read) {
        next if $ent =~ m!^\.!;
        if (-d "$dir/$ent") {
            push @folders, Remedie::Folder->new($ent, $self);
        }
    }

    return @folders;
}

sub locate_files {
    my($self, $cgi, $path) = @_;

    my $dir = $self->path2dir($path);
    my $re = "\\.(" . join("|", map { split / / } values %{$self->{conf}->{extensions}}) . ')$';

    my $finder = File::Find::Rule->file->name(qr/$re/);
    if (my $match = $cgi->param('q')) {
        # new CGI.pm automatically decodes utf-8, older ones don't.
        unless (utf8::is_utf8($match)) {
            $match = Encode::decode_utf8($match);
            $cgi->param('q' => $match);
        }

        $self->{stash}->{title} = $match;

        my $match_encoded = Encode::encode($self->{conf}->{fs_encoding}, $match);

        # try to compile the input as a regexp. If it doesn't compile,
        # treat as a non-regexp partial match
        my $no_regexp = $cgi->param('no_regexp');
        unless ($no_regexp) {
            eval { qr/$match_encoded/ };
            $no_regexp = 1 if $@;
        }

        if ($no_regexp) {
            $match_encoded = quotemeta $match_encoded;
        }
        $match_encoded =~ s/\\? +/.*/g; # transform search query into regexp: better UE
        $finder->name(qr/$match_encoded/i);
    }

    return map Remedie::File->new( Encode::decode($self->{conf}->{fs_encoding}, $_), $self),
        $finder->in($dir);
}

sub path2dir {
    my($self, $path) = @_;

    my @path = ($self->{conf}->{media_path});
    push @path, $path if $path;
    my $dir = join "/", @path;
    unless (-e $dir && -r _) {
        die "Directory '$dir' not found.\n";
    }
    return $dir;
}

sub handle_file {
    my($self, $cgi, $path) = @_;

    $path = join "/",
        $self->{conf}->{media_path},
        Encode::decode_utf8(URI::Escape::uri_unescape($path));

    my $file = Remedie::File->new($path, $self);
    $file && $file->stat or die "File '$path' not found";

    my $rawpath = $file->encoded_path;
    my $mime    = $file->mime_type;

    if ($ENV{HTTP_RANGE} && $ENV{HTTP_RANGE} =~ m!^bytes=(\d*)-(\d*)$!) {
        use bytes;
        my($from, $to) = ($1, $2);
        open my $in, $rawpath or die "$rawpath: $!";
        my $size = -s $in;
        $to    ||= $size - 1;

        print "HTTP/1.0 206 Partial content\r\n";
        print "Content-Type: $mime\r\n",
            "Content-Length: @{[$to - $from + 1]}\r\n",
            "Content-Range: bytes $from-$to/$size\r\n\r\n";
        sysseek $in, $from, 0;
        my $remain = $to - $from + 1;
        while ($remain > 0) {
            sysread($in, my($out), 1024);
            print $out;
            $remain -= length $out;
        }
    } else {
        my $size = -s $rawpath;
        print "HTTP/1.0 200 OK\r\n";
	print "Content-Type: $mime\r\nContent-Length: $size\r\n\r\n";
        if ($ENV{REQUEST_METHOD} eq 'GET') {
            open my $in, $rawpath or die "$rawpath: $!";
            print $_ while <$in>;
        }
    }
}

sub net_server {
    my $self = shift;
    $self->{conf}->{net_server} ? "Net::Server::" . $self->{conf}->{net_server} : undef;
}

package Remedie::File;
use DateTime;
use DateTime::Format::Mail;
use Digest::MD5;
use Encode;
use File::Basename;
use File::stat ();

my $MimeTypes = MIME::Types->new;
$MimeTypes->addType(MIME::Type->new(type => 'video/flv', extensions => [ 'flv' ] ));
$MimeTypes->addType(MIME::Type->new(type => 'video/x-matroska', extensions => [ 'mkv' ] ));
$MimeTypes->addType(MIME::Type->new(type => 'video/subtitle', extensions => [ 'sub', 'srt' ] ));
$MimeTypes->addType(MIME::Type->new(type => 'video/divx', extensions => [ 'divx' ] ));
$MimeTypes->addType(MIME::Type->new(type => 'applicatoin/x-bittorrent', extension => [ 'torrent' ]));

sub new {
    my($class, $path, $server) = @_;
    my $self = bless { unicode_path => $path, conf => $server->{conf} }, $class;
    $self->init or return;
    $self;
}

sub init {
    my $self = shift;

    $self->{path} = $self->{unicode_path};
    $self->{path} =~ s!^$self->{conf}->{media_path}(?:/|\\)!!;

    my $ext;
    my $base = File::Basename::basename($self->{path});
    $base =~ s/\.(\w+)$/$ext = $1; ""/e;

    my $dir  = File::Basename::dirname($self->{path});
    return if $self->should_ignore($dir);

    $base =~ s/_/ /g;
    $dir  =~ s/_/ /g;

    # If filename doesn't contain directory name, prepend it
    if ($dir && $dir ne '.' && $base !~ /\Q$dir\E/) {
        $base = "$dir - $base";
    }

    my $tag_re = '[\[\(【]([^\)\]】]*)[\)\]】]';
    my @tags;
    while ( $base =~ s/^$tag_re\s*|\s*$tag_re\.?$// ) {
        push @tags, $1 || $2;
    }

    if ($base =~ s/\.(HR|[HP]DTV|WS|AAC|AC3|DVDRip|PROPER|DVDSCR|720p|1080p|[hx]264(?:-\w+)?|dd51)\.(.*)//i) {
        my $tags = "$1.$2";
        $base =~ s/\./ /g;
        # ad-hoc: rescue DD.MM.YY(YY)
        $base =~ s/(\d\d) (\d\d) (\d\d(\d\d)?)\b/$1.$2.$3/;
        push @tags, split /\./, $tags;
    }

    $self->{name} = $base;
    $self->{tags} = \@tags;
    $self->{ext}  = $ext;

    return $self;
}

sub stat {
    my $self = shift;
    $self->{stat} ||= File::stat::stat($self->encoded_path);
}

sub size {
    my $self = shift;
    $self->stat->size;
}

sub thumb_path {
    my $self  = shift;
    my $thumb = Digest::MD5::md5_hex( $self->encoded_path ) . ".jpg";
    return join "/", $self->thumb_dir, $thumb;
}

sub thumb_dir {
    my $self = shift;
    return join "/",
	$self->{conf}->{media_path},
        ($self->{conf}->{thumb_path} || ".remedie-thumbs");
}

sub thumb_url {
    my($self, $base) = @_;
    $self->url_for($self->thumb_path, $base);
}

sub has_thumb {
    my $self = shift;

    # don't check -x flag for Windows portability
    return unless $self->{conf}->{ffmpeg} && -e $self->{conf}->{ffmpeg};

    # XXX need this to somewhere else in the init
    mkdir $self->thumb_dir, 0777 unless -e $self->thumb_dir;

    if (-e $self->thumb_path) {
        return -s _; # return the size
    } else {
	open my $oldout, ">&STDOUT"     or die "Can't dup STDOUT: $!";
	open STDOUT, ">>", "ffmpeg.log" or die "Can't redirect STDOUT: $!";
	select STDOUT; $| = 1;
        system(
            $self->{conf}->{ffmpeg},
            "-i", $self->encoded_path,
            '-f'       => 'image2',
            '-pix_fmt' => 'jpg',
            '-vframes' => 1,
            '-ss'      => 3,
            '-an',
            '-deinterlace',
            $self->thumb_path,
        );
	open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";

        if (my $size = -s $self->thumb_path) {
            return $size;
        }

        open my $out, ">", $self->thumb_path; # create an empty file
        close $out;
        return 0;
    }
}

sub encoded_path {
    my $self = shift;
    Encode::encode($self->{conf}->{fs_encoding}, $self->{unicode_path});
}

sub should_ignore {
    my($self, $name) = @_;
    return $name =~ /^Recycle[dr]|System Volume Information|\.partial/i;
}

sub creation_date {
    my $self = shift;
    $self->{creation_date} ||= DateTime->from_epoch( epoch => $self->stat->mtime );
}

my $formatter = DateTime::Format::Mail->new;

sub creation_date_rfc822 {
    my $self = shift;
    $formatter->format_datetime($self->creation_date);
}

sub url {
    my($self, $base) = @_;
    $self->url_for($self->{unicode_path}, $base);
}

sub url_for {
    my($self, $path, $base) = @_;

    my $uri  = $path || '';
    $uri =~ s!^$self->{conf}->{media_path}(?:/|\\)!/files/!;
    $uri =  URI::Escape::uri_escape_utf8($uri, "^A-Za-z0-9\-_.!~*'():/");
    if ($self->{conf}->{web_server}) {
        $uri =~ s!^/files/!$self->{conf}->{web_server}/!;
    } else {
        $uri = $base . $uri;
    }

    return $uri;
}

sub mime_type {
    my $self = shift;
    my $mime = $MimeTypes->mimeTypeOf($self->{ext});
    return $mime ? $mime->type : 'application/octet-stream';
}

package Remedie::Folder;
sub new {
    my($class, $ent, $server) = @_;
    bless {
        name => Encode::decode($server->{conf}->{fs_encoding}, $ent),
        path => $ent,
    }, $class;
}

sub name_utf8 {
    my $self = shift;
    return Encode::encode_utf8($self->{name});
}

package main;
use Getopt::Long;
use YAML;

my %opt = (conf => 'remedie.yaml');
GetOptions(\%opt, "--conf=s");

my $conf = YAML::LoadFile($opt{conf});
my $server = Remedie::Server->new($conf->{port});
$server->set_conf($conf);
$server->host($conf->{listen_ip}) if $conf->{listen_ip};
$server->load_feed_icon;
$server->run;

package Remedie::Server;
__DATA__
R0lGODlhDAAMAOYAAPSTPf3x5uOAPu6GOu6HOvabROuDOemOQuqPQuBpLOh7N+t+MuuAOfGMPOd2MPKPPOV2NvCLO+6FM/WWPuNvLvGKNOB7PeNyNfOPNvWVO/GxivzAg/mrXfrl2Peyde2aY/eZP/q4dvScT/q9g/ujRv7nzuVzLvu/g/uvX/jEmuOAU+yHPvnHmvS8mP3q2fOkZt9qMPmxav7z5u6mffu6d+FuNPq3dvO2i/SSPfuuXv3v5fCdZfaraOuAMfi5gf748uh5MOl+N/jFmvGVTdteKvGPOeZ6M/CNQN1jK/3w5veXOO+GNPaUN/7y5viYOPqbOfOONvjk1/udOv/58////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAAAAAAALAAAAAAMAAwAAAeNgFECQQYEEQ8AExkIgiYfKxIVGExOT1IHRkBUVEksBZVSSjgGPS9CLlRNOaFQDQQSKTxMIVNTHFBLAxEVm000KFMBRwsMDxgFJzJUNh5UNw4KAEwxGyRNAUs6HRQQE05TVCM+VDstVAkXIE8lPyJDVBozVCowCKxLCw4UCUhEFlEHijQYwEABhAs1/gUCADs=
